home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 2: CDPD 1
/
Almathera Ten on Ten - Disc 2: CDPD 1.iso
/
pd
/
101-125
/
105
/
basicprogs
/
leastsquare
< prev
next >
Wrap
Text File
|
1995-03-13
|
13KB
|
526 lines
DIM P(20), r(20), v(20), X(20), Y(20), z(20,20)
DEFDBL a-z
DEFSNG PrintY
SCREEN 2,640,200,3,2
WINDOW 2,,,0,2
WIDTH 80
Round$ = "################.####"
MenuFlag = 0 'for degree count
LOCATE 10,28
PRINT "Want instructions (Y/N)?"
Instruct:
Want$ = INKEY$
IF Want$ = "" THEN Instruct
Want$ = UCASE$(Want$)
IF Want$ <> "Y" AND Want$ <> "N" THEN Instruct
CLS
IF Want$ = "N" THEN GOTO Start
IntroFlag = 0
RESTORE
PrintIntro:
FOR j% = 1 TO 23
READ d$
Over = INT((80 - LEN(d$))/2)
PRINT SPACE$(Over) d$
NEXT
EndIntro:
IF INKEY$ = "" THEN EndIntro
IF IntroFlag = 0 THEN
CLS
IntroFlag = 1
GOTO PrintIntro
END IF
Start:
CLS
WIDTH 70
NumPairs = 0
HowManyPlaces:
LOCATE 5,11
PRINT "How many decimal places do you want to show - 2 is mimimum"
LOCATE 6,11
INPUT "(Enter your choice then press RETURN) "; Places
IF Places < 2 THEN
PRINT " Everybody wants to be a comedian. Try again."
PRINT
GOTO HowManyPlaces
END IF
IF Places > 16 THEN
PRINT "16 is as high as the machine goes. Try again."
GOTO Start
END IF
Place$ = "." + LEFT$(Round$,Places)
Round$ = Round$ + Place$
Places = Places + 1
InputLoop:
PRINT
NumPairs = NumPairs+1
COLOR 3,0
PRINT " Pair"; NumPairs;
COLOR 4,0
PRINT " (C to start calculating - D to delete last pair)"
COLOR 1,0
PRINT " Input the first number of the pair then press RETURN"
GOSUB GetIt
IF Final$ = "C" AND NumPairs > 2 THEN NumPairs = NumPairs-1: GOTO SetDegree
IF Final$ = "D" AND NumPairs > 1 THEN NumPairs = NumPairs-2: GOTO InputLoop
X(NumPairs) = Final
PRINT
PRINT " Input the second Number of the pair then press RETURN"
GOSUB GetIt
IF Final$ = "C" AND NumPairs > 2 THEN NumPairs = NumPairs-1: GOTO SetDegree
IF Final$ = "D" AND NumPairs > 1 THEN NumPairs = NumPairs-2: GOTO InputLoop
Y(NumPairs) = Final
GOTO InputLoop
SetDegree:
CLS
FOR j% = 1 TO NumPairs 'sort in ascending order
FOR k% = j% TO NumPairs
IF X(j%) > X(k%) THEN
SWAP X(j%), X(k%)
SWAP Y(j%), Y(k%)
END IF
NEXT
NEXT
Degree = NumPairs - 1
IF Degree > 9 THEN Degree = 9
FOR WhatDeg = 1 TO Degree: GOSUB Calculate: NEXT
PrintMenu:
MenuFlag = 1
COLOR 5,0
PRINT
PRINT
PRINT SPACE$(38)"MENU"
PRINT
PRINT SPACE$(20)"1 - Drop this equation and find another"
PRINT SPACE$(20)"2 - Determine Y given X"
PRINT SPACE$(20)"3 - List all pairs"
PRINT SPACE$(20)"4 - Quit"
PRINT SPACE$(20)"5 - Graph"
COLOR 1,0
PRINT "
GetQ:
q$ = INKEY$
q = VAL(q$)
IF q<1 OR q>5 THEN GetQ
ON q GOTO Start, FindY, ListPairs, EndIt, GraphIt
GOTO PrintMenu
FindY:
WhatDeg = 0: INPUT "What degree equation do you want to use"; WhatDeg
GOSUB Calculate
NextY:
PRINT
PRINT "(R to return to menu)"
INPUT "x = "; X$
X = VAL(X$)
X$ = UCASE$(X$)
IF X$ = "R" THEN GOTO PrintMenu
YValue = 0
FOR k% = 1 TO WhatDeg + 1
YValue = YValue + v(k%) * X ^ (k%-1)
NEXT
PRINT "y ="; YValue
GOTO NextY
ListPairs:
PRINT
FOR j% = 1 TO NumPairs
PRINT "Pair";j%,
Length = LEN(STR$(INT(X(j%))))
PrintNum$ = RIGHT$(Round$,Length + Places)
IF X(j%) < 0 THEN PRINT "-";
PRINT USING PrintNum$; ABS((X(j%))),
PRINT " ",
Length = LEN(STR$(INT(Y(j%))))
PrintNum$ = RIGHT$(Round$,Length + Places)
IF Y(j%) < 0 THEN PRINT "-";
PRINT USING PrintNum$; ABS((Y(j%)))
NEXT
PRINT
PRINT "<D>elete a pair <A>dd a pair <R>ecalculate <M>enu"
UpDate:
UD$ = INKEY$
IF UD$ = "" THEN UpDate
UD$ = UCASE$(UD$)
IF UD$ <> "D" AND UD$ <> "A" AND UD$ <> "R" AND UD$ <> "M" THEN UpDate
IF UD$ = "M" THEN GOTO PrintMenu
IF UD$ = "R" THEN GOTO SetDegree
IF UD$ = "A" THEN AddPair
DeltePair:
INPUT "Delete which pair"; Which
IF Which < 1 OR Which > NumPairs GOTO DeletePair
SWAP X(Which), X(NumPairs)
SWAP Y(Which), Y(NumPairs)
NumPairs = NumPairs - 1
GOTO ListPairs
AddPair:
NumPairs = NumPairs + 1
INPUT "X ="; X(NumPairs)
INPUT "Y ="; Y(NumPairs)
GOTO ListPairs
PrintPlus: 'print sign before number
IF POS(1)>60 THEN PRINT
IF Flag = 1 AND v(j%)> = 0 THEN PRINT " +";
IF v(j%) < 0 THEN PRINT " -";
RETURN
EndIt:
WINDOW CLOSE 2
SCREEN CLOSE 2
LIST
END
Calculate:
d = WhatDeg: n = d + 1: d2 = 2 * d
FOR j% = 1 TO d2
P(j%) = 0
FOR k% = 1 TO NumPairs
P(j%) = P(j%) + X(k%) ^ j%
NEXT
NEXT
P(0) = NumPairs
r(1) = 0
FOR j% = 1 TO NumPairs
r(1) = r(1) + Y(j%)
NEXT
IF n = 1 THEN GOTO Jump1
FOR j% = 2 TO n
r(j%) = 0
FOR k% = 1 TO NumPairs
r(j%) = r(j%) + Y(k%) * X(k%) ^ (j%-1)
NEXT
NEXT
Jump1:
FOR j% = 1 TO n
FOR k% = 1 TO n
z(j%,k%) = P(j%+k%-2)
NEXT
NEXT
GOSUB Calculate2
PRINT : PRINT "degree = "; d
PRINT "y ="; : Flag = 0
FOR j% = n TO 1 STEP-1: IF v(j%)=0 THEN Jump3
IF j% = 1 THEN
GOSUB PrintPlus
Length = LEN(STR$(INT(v(j%))))
PrintNum$ = RIGHT$(Round$,Length + Places)
PRINT USING PrintNum$; ABS((v(j%)))
GOTO Jump2
END IF
IF j% = 2 THEN
GOSUB PrintPlus
Length = LEN(STR$(INT(v(j%))))
PrintNum$ = RIGHT$(Round$,Length + Places)
PRINT USING PrintNum$; ABS((v(j%)));
COLOR 3,0
PRINT "x ";
COLOR 1,0
GOTO Jump2
END IF
GOSUB PrintPlus
Length = LEN(STR$(INT(v(j%))))
PrintNum$ = RIGHT$(Round$,Length + Places)
PRINT USING PrintNum$; ABS((v(j%)));
COLOR 3,0
PRINT "x^"; RIGHT$(STR$(j%-1),1);
COLOR 1,0
Jump2:
Flag = 1
Jump3:
IF POS(1)>60 THEN PRINT
NEXT
q = 0
FOR j% = 1 TO NumPairs
q = q+Y(j%)
NEXT
m = q/NumPairs: t = 0: g = 0
FOR j% = 1 TO NumPairs
q = 0
FOR k% = 1 TO n
q = q + v(k%) * X(j%) ^ (k%-1)
NEXT
t = t + (Y(j%) - q) ^ 2
g = g + (Y(j%) - m) ^ 2
NEXT
IF g = 0 THEN t = 1: GOTO PrintFit
t = 1 - t/g
PrintFit:
PRINT
PRINT INT(t * 100); "% fit"
IF MenuFlag = 0 THEN HighestDeg = HighestDeg + 1
RETURN
Calculate2:
IF n = 1 THEN v(1) = r(1) / z(1,1): RETURN
FOR k% = 1 TO n-1
a% = k% + 1
b = k%
Skip1:
IF ABS(z(a%,k%)) > ABS(z(b,k%)) THEN b = a%
IF a% < n THEN a% = a% + 1: GOTO Skip1
IF b = k% THEN GOTO Skip2
FOR j% = k% TO n: q = z(k%,j%): z(k%,j%) = z(b,j%)
z(b,j%) = q
NEXT
q = r(k%): r(k%) = r(b): r(b) = q
Skip2:
a% = k% + 1
Skip3:
q = z(a%,k%) / z(k%,k%): z(a%,k%) = 0
FOR j% = k% + 1 TO n: z(a%,j%) = z(a%,j%) - q * z(k%,j%): NEXT
r(a%) = r(a%) - q * r(k%): IF a% < n THEN a% = a% + 1: GOTO Skip3
NEXT
v(n) = r(n) / z(n,n)
FOR a% = n - 1 TO 1 STEP -1
q = 0
FOR j% = a% + 1 TO n: q = q + z(a%,j%) * v(j%)
v(a%) = (r(a%) - q) / z(a%,a%)
NEXT
NEXT
RETURN
GraphIt:
Max = X(NumPairs)
Min = X(1)
PRINT
PRINT "Your low X point was "; Min
PRINT "Your high X point was "; Max
PRINT
PRINT "<1> Use these points to graph <2> Use other points to graph"
PRINT
UseWhich:
UW$ = INKEY$
IF UW$ = "" THEN UseWhich
IF VAL(UW$) < 1 OR VAL(UW$) > 2 THEN UseWhich
IF VAL(UW$) = 1 THEN
LowX = Min
HighX = Max
GOTO FindDiff
END IF
INPUT "Input the low x value then press RETURN"; LowX
INPUT "Input the high x value then press RETURN"; HighX
PRINT
FindDiff:
Max = -1E+30
Min = 1E+30
Diff1 = ABS(HighX - LowX)
Diff = Diff1/500
WhatDeg = 0
PRINT "What degree equation do you want to use?";
FindDegree:
WhatDeg$ = INKEY$
IF WhatDeg$ = "" THEN FindDegree
WhatDeg = VAL(WhatDeg$)
IF WhatDeg < 1 THEN
PRINT " Invalid entry - try again"
PRINT
PRINT "What degree equation do you want to use?";
GOTO FindDegree
END IF
PRINT WhatDeg
GOSUB Calculate
PRINT
PRINT "Scaling....."
HighEnd = HighX + (Diff/2)
FOR Look = LowX TO HighEnd STEP Diff 'find max and min
YValue = 0
FOR k% = 1 TO WhatDeg + 1
YValue = YValue + v(k%) * Look ^ (k%-1)
NEXT
IF YValue < Min THEN Min = YValue
IF YValue > Max THEN Max = YValue
NEXT
CLS
GOSUB Makegrid
Scaler2 = 152/(Max - Min)
Scaler1 = 20 - (Min * Scaler2)
XCount = 119
FOR Plot = LowX TO HighX STEP Diff 'plot graph
YValue = 0
FOR k% = 1 TO WhatDeg + 1
YValue = YValue + v(k%) * Plot ^ (k%-1)
NEXT
XCount = XCount + 1
YPlot = (YValue * Scaler2) + Scaler1
YPlot = 192 - YPlot ' invert
PSET(XCount,YPlot)
NEXT
Diff = 500/ABS(LowX - HighX) 'plot the user's points
FOR PP = 1 TO NumPairs
NewX = (ABS(X(PP) - LowX) * Diff) + 120
NewY = 192 - ((Y(PP) * Scaler2) + Scaler1)
CIRCLE (NewX,NewY),5,5
CIRCLE (NewX,NewY),6,5
NEXT
LOCATE 24,23
COLOR 7,0
PRINT "PRESS ANY KEY TO RETURN TO THE MENU";
COLOR 1,0
WaitForKey:
IF INKEY$ = "" THEN WaitForKey
CLS
GOTO PrintMenu
Makegrid: 'draw garph grid on screen
FOR Grid = 120 TO 630 STEP 25
COLOR 2,0
LINE (Grid,20) - (Grid,172)
IF (Grid - 120) MOD 100 = 0 THEN
COLOR 3,0
LINE (Grid,8) - (Grid,19)
END IF
NEXT
COLOR 2,0
FOR Grid = 20 TO 172 STEP 8
LINE (0,Grid) - (620,Grid)
NEXT
COLOR 3,0
FOR Grid = 20 TO 172 STEP 8
LINE (0,Grid) - (120,Grid)
NEXT
COLOR 1,0 'print Y scale
LOCATE 3,1
MinMax = (Max - Min)/19
PrintY = Max
FOR Grid = 1 TO 20
PRINT PrintY
PrintY = PrintY - MinMax
NEXT
COLOR 1,0 'print X scale
Up$ = ""
WIDTH 80
AddX = 0
PadFlag = 0
UDFlag = 0
XDiff = ABS(LowX - HighX)/10
AddX = AddX - XDiff
LOCATE 1,1
FOR XX = 1 TO 11
UDFlag = ABS(UDFlag - 1)
AddX = AddX + XDiff
XPrint = AddX + LowX
XPrint$ = LEFT$(STR$(XPrint),7)
WHILE LEN(XPrint$) < 12
XPrint$ = " " + XPrint$
WEND
IF UDFlag = 1 THEN
Up$ = Up$ + XPrint$
IF PadFlag = 0 THEN
Up$ = Up$ + " "
PadFlag = 1
END IF
END IF
NEXT
LOCATE 2,5
PRINT Up$
RETURN
GetIt: 'input routine
COLOR 7,0
PRINT " ---> ";
Final$ = ""
GetItOn:
User$ = INKEY$
IF User$ = "" THEN GetItOn
User$ = UCASE$(User$)
IF User$ = "C" THEN Final$ = "C": GOTO EndGet
IF User$ = "D" THEN Final$ = "D": GOTO EndGet
IF User$ = CHR$(8) OR User$ = CHR$(127) THEN 'backspace
PRINT User$;
Final$ = LEFT$(Final$,LEN(Final$)-1)
GOTO GetItOn
END IF
IF User$ = "," THEN GetItOn
IF User$ = CHR$(13) THEN
Final = VAL(Final$)
PRINT
IF Final$ = "" THEN
BEEP
PRINT "RETURN with no input - try again"
PRINT
GOTO GetItOn
END IF
GOTO EndGet
END IF
Final$ = Final$ + User$
PRINT User$;
GOTO GetItOn
EndGet:
COLOR 1,0
RETURN
DATA "Least Squares"
DATA " "
DATA "C 1987 to George Trepal 2650 Alturas Rd Bartow FL 33830"
DATA "a shareware program - OK to give free but not to sell"
DATA " "
DATA " This program uses the Least Squares technique to find equations"
DATA "from points. For example if you can microwave two muffins in"
DATA "25 seconds, three muffins in 50 seconds, and four muffins in 120"
DATA "seconds how long will five muffins take? To solve the mystery"
DATA "feed the program the point pairs"
DATA " "
DATA "Muffins Seconds"
DATA "2 25"
DATA "3 50"
DATA "4 120"
DATA " "
DATA "then tell it to calculate. It'll produce equations of different"
DATA "degrees and judge their quality. Pick the one of highest quality"
DATA "and feed it 5 to find how long five muffins would take."
DATA " Of course there are other uses. You can use it for trend"
DATA "analysis or for graphics programs to find a complex curve that"
DATA "exactly fits your needs. And it's great to check your homework."
DATA "---> PRESS ANY KEY TO READ MORE <---"
DATA " "
DATA "WARNING! Equations above the second degree are sometimes tricky."
DATA "Instead of a smooth curve that fits your points they may be snakes"
DATA "that merely intersect them. Always graph an equation to see what"
DATA "it's realy like."
DATA " "
DATA "Predicted points far away from known points tend to be wrong so"
DATA "use common sense about what you trust.
DATA " "
DATA "If this program can't give you a nice equation from your points don't"
DATA "give up. There's a lot of math, such as trig functions, this program"
DATA "can't handle. What It can handle it handles very well but it's not a"
DATA "universal curve finder."
DATA " "
DATA " "
DATA "This is version 1.0"
DATA " "
DATA "Released to public domain September 1987"
DATA " "
DATA "If you like this program please send a contribution."
DATA " "
DATA " "
DATA "PRESS ANY KEY TO CONTINUE"